home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Informant Complete 1995 - 2000
/
Delphi Informant Complete 1995 to 2000.iso
/
Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar
/
1998
/
Mar
/
DI9803DM
/
CalendarX
/
CalImpl.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-12-01
|
8KB
|
314 lines
unit CalImpl;
interface
uses
Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
ComServ, StdVCL, AXCtrls, CalendarX_TLB, Calendar, Grids, AXPropBg;
type
// Descend from TActiveXPropBag to get automatic streaming of properties
// via IPersistPropertyBag and Delphi's native RTTI
TCalendarX = class(TActiveXPropBag, ICalendarX)
private
{ Private declarations }
FDelphiControl: TCalendar;
FEvents: ICalendarXEvents;
procedure ChangeEvent(Sender: TObject);
procedure ClickEvent(Sender: TObject);
procedure DblClickEvent(Sender: TObject);
procedure KeyPressEvent(Sender: TObject; var Key: Char);
protected
{ Protected declarations }
procedure InitializeControl; override;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
function Get_BorderStyle: TxBorderStyle; safecall;
function Get_CalendarDate: TDateTime; safecall;
function Get_Color: TColor; safecall;
function Get_Ctl3D: WordBool; safecall;
function Get_Cursor: Smallint; safecall;
function Get_Day: Integer; safecall;
function Get_Enabled: WordBool; safecall;
function Get_Font: Font; safecall;
function Get_GridLineWidth: Integer; safecall;
function Get_Month: Integer; safecall;
function Get_ParentColor: WordBool; safecall;
function Get_ReadOnly: WordBool; safecall;
function Get_StartOfWeek: Smallint; safecall;
function Get_UseCurrentDate: WordBool; safecall;
function Get_Visible: WordBool; safecall;
function Get_Year: Integer; safecall;
procedure NextMonth; safecall;
procedure NextYear; safecall;
procedure PrevMonth; safecall;
procedure PrevYear; safecall;
procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
procedure Set_CalendarDate(Value: TDateTime); safecall;
procedure Set_Color(Value: TColor); safecall;
procedure Set_Ctl3D(Value: WordBool); safecall;
procedure Set_Cursor(Value: Smallint); safecall;
procedure Set_Day(Value: Integer); safecall;
procedure Set_Enabled(Value: WordBool); safecall;
procedure Set_Font(const Value: Font); safecall;
procedure Set_GridLineWidth(Value: Integer); safecall;
procedure Set_Month(Value: Integer); safecall;
procedure Set_ParentColor(Value: WordBool); safecall;
procedure Set_ReadOnly(Value: WordBool); safecall;
procedure Set_StartOfWeek(Value: Smallint); safecall;
procedure Set_UseCurrentDate(Value: WordBool); safecall;
procedure Set_Visible(Value: WordBool); safecall;
procedure Set_Year(Value: Integer); safecall;
procedure UpdateCalendar; safecall;
end;
implementation
uses
CalPage, ComObj, AxTools;
{ TCalendarX }
procedure TCalendarX.InitializeControl;
begin
FDelphiControl := Control as TCalendar;
FDelphiControl.OnChange := ChangeEvent;
FDelphiControl.OnClick := ClickEvent;
FDelphiControl.OnDblClick := DblClickEvent;
FDelphiControl.OnKeyPress := KeyPressEvent;
end;
procedure TCalendarX.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as ICalendarXEvents;
end;
procedure TCalendarX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
{ Define property pages here. Property pages are defined by calling
DefinePropertyPage with the class id of the page. For example,
DefinePropertyPage(Class_CalendarXPage); }
DefinePropertyPage(Class_CalendarPage);
DefinePropertyPage(Class_DFontPropPage);
end;
function TCalendarX.Get_BorderStyle: TxBorderStyle;
begin
Result := Ord(FDelphiControl.BorderStyle);
end;
function TCalendarX.Get_CalendarDate: TDateTime;
begin
Result := FDelphiControl.CalendarDate;
end;
function TCalendarX.Get_Color: TColor;
begin
Result := FDelphiControl.Color;
end;
function TCalendarX.Get_Ctl3D: WordBool;
begin
Result := FDelphiControl.Ctl3D;
end;
function TCalendarX.Get_Cursor: Smallint;
begin
Result := Smallint(FDelphiControl.Cursor);
end;
function TCalendarX.Get_Day: Integer;
begin
Result := FDelphiControl.Day;
end;
function TCalendarX.Get_Enabled: WordBool;
begin
Result := FDelphiControl.Enabled;
end;
function TCalendarX.Get_Font: Font;
begin
GetOleFont(FDelphiControl.Font, Result);
end;
function TCalendarX.Get_GridLineWidth: Integer;
begin
Result := FDelphiControl.GridLineWidth;
end;
function TCalendarX.Get_Month: Integer;
begin
Result := FDelphiControl.Month;
end;
function TCalendarX.Get_ParentColor: WordBool;
begin
Result := FDelphiControl.ParentColor;
end;
function TCalendarX.Get_ReadOnly: WordBool;
begin
Result := FDelphiControl.ReadOnly;
end;
function TCalendarX.Get_StartOfWeek: Smallint;
begin
Result := Smallint(FDelphiControl.StartOfWeek);
end;
function TCalendarX.Get_UseCurrentDate: WordBool;
begin
Result := FDelphiControl.UseCurrentDate;
end;
function TCalendarX.Get_Visible: WordBool;
begin
Result := FDelphiControl.Visible;
end;
function TCalendarX.Get_Year: Integer;
begin
Result := FDelphiControl.Year;
end;
procedure TCalendarX.NextMonth;
begin
FDelphiControl.NextMonth;
end;
procedure TCalendarX.NextYear;
begin
FDelphiControl.NextYear;
end;
procedure TCalendarX.PrevMonth;
begin
FDelphiControl.PrevMonth;
end;
procedure TCalendarX.PrevYear;
begin
FDelphiControl.PrevYear;
end;
procedure TCalendarX.Set_BorderStyle(Value: TxBorderStyle);
begin
FDelphiControl.BorderStyle := TBorderStyle(Value);
end;
procedure TCalendarX.Set_CalendarDate(Value: TDateTime);
begin
FDelphiControl.CalendarDate := Value;
end;
procedure TCalendarX.Set_Color(Value: TColor);
begin
FDelphiControl.Color := Value;
end;
procedure TCalendarX.Set_Ctl3D(Value: WordBool);
begin
FDelphiControl.Ctl3D := Value;
end;
procedure TCalendarX.Set_Cursor(Value: Smallint);
begin
FDelphiControl.Cursor := TCursor(Value);
end;
procedure TCalendarX.Set_Day(Value: Integer);
begin
FDelphiControl.Day := Value;
end;
procedure TCalendarX.Set_Enabled(Value: WordBool);
begin
FDelphiControl.Enabled := Value;
end;
procedure TCalendarX.Set_Font(const Value: Font);
begin
SetOleFont(FDelphiControl.Font, Value);
end;
procedure TCalendarX.Set_GridLineWidth(Value: Integer);
begin
FDelphiControl.GridLineWidth := Value;
end;
procedure TCalendarX.Set_Month(Value: Integer);
begin
FDelphiControl.Month := Value;
end;
procedure TCalendarX.Set_ParentColor(Value: WordBool);
begin
FDelphiControl.ParentColor := Value;
end;
procedure TCalendarX.Set_ReadOnly(Value: WordBool);
begin
FDelphiControl.ReadOnly := Value;
end;
procedure TCalendarX.Set_StartOfWeek(Value: Smallint);
begin
FDelphiControl.StartOfWeek := TDayOfWeek(Value);
end;
procedure TCalendarX.Set_UseCurrentDate(Value: WordBool);
begin
FDelphiControl.UseCurrentDate := Value;
end;
procedure TCalendarX.Set_Visible(Value: WordBool);
begin
FDelphiControl.Visible := Value;
end;
procedure TCalendarX.Set_Year(Value: Integer);
begin
FDelphiControl.Year := Value;
end;
procedure TCalendarX.UpdateCalendar;
begin
FDelphiControl.UpdateCalendar;
end;
procedure TCalendarX.ChangeEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnChange;
end;
procedure TCalendarX.ClickEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnClick;
end;
procedure TCalendarX.DblClickEvent(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnDblClick;
end;
procedure TCalendarX.KeyPressEvent(Sender: TObject; var Key: Char);
var
TempKey: Smallint;
begin
TempKey := Smallint(Key);
if FEvents <> nil then FEvents.OnKeyPress(TempKey);
Key := Char(TempKey);
end;
initialization
// This makes the factory mark this control as "safe"
TActiveXSafeFactory.Create(
ComServer,
TCalendarX,
TCalendar,
Class_CalendarX,
1,
'',
0);
end.